home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / menusLite.tcl < prev    next >
Text File  |  1996-01-15  |  7KB  |  331 lines
  1. # My menus.        
  2.  
  3. menu -n File -p fileMenuProc {
  4.     "/Nnew"
  5.     "/Oopen╔"
  6.     {menu -m -n filesets {}}
  7.     "<S/Wclose"
  8.     "<S<I<O/WcloseAll"
  9.     "(-"
  10.     "<S/Ssave"
  11.     "<S<I<O/SsaveAll"
  12.     "<SsaveAs╔"
  13.     "<E<SrevertToBackup"
  14.     "<Srevert"
  15.     "(-"
  16.     "pageSetup╔"
  17.     "/Pprint╔"
  18.     "(-"
  19.     "/Qquit"
  20. }
  21.  
  22. proc fileMenuProc {menu item} {
  23.     if {$item == "open"} {
  24.         findFile
  25.     } elseif {$item == "close"} {
  26.         killWindow
  27.     } else {
  28.         $item
  29.     }
  30. }
  31.  
  32. menu -n Edit {
  33.     "/Zundo"
  34.     "/Z<I<Oredo"
  35.     {menu -n emacs {}}
  36.     "(-"
  37.     "/X<Scut"
  38.     "/X<S<I<Ocut&Append"
  39.     "/C<Scopy"
  40.     "/C<S<I<Ocopy&Append"
  41.     "/V<Spaste"
  42.     "/V<S<I<OpastePop"
  43.     "/A<SselectAll"
  44.     "/A<S<I<OselectParagraph"
  45.     "clear"
  46.     "(-"
  47.     "/=selectLast"
  48.     "/`<Stwiddle"
  49.     "/`<S<I<OtwiddleWords"
  50. }
  51.  
  52. proc selectLast {} { markHilite }
  53.  
  54. #%     {/[<SshiftLeft}
  55. #%     {/[<S<I<OshiftLeftSpace}
  56. #%     {/]<SshiftRight}
  57. #%     {/]<S<I<OshiftRightSpace}
  58.  
  59.  
  60. menu -n Search {
  61.     "/F<Sfind╔"
  62.     "/F<S<I<OsearchStart"
  63.     "/G<SfindAgain"
  64.     "/G<S<I<OfindAgainBackward"
  65.     "/H<I<OfindInNextFile"
  66.     "/E<SenterSearchString"
  67.     "/E<S<I<OenterReplaceString"
  68.     "(-"
  69.     "/S<BquickFind"
  70.     "/R<BreverseQuickFind"
  71.     "(-"
  72.     "/R<Sreplace"
  73.     "/R<S<I<OreplaceAll"
  74.     "/Hreplace&FindAgain"
  75.     "(-"
  76.     "/,<BpushPosition"
  77.     "/.<BpopPosition"
  78.     "/G<IgotoLine"
  79. }
  80.  
  81. # ==== NOTE:  rectMarkHilite, onespace, centerRedraw, doTab
  82. menu -n Text {
  83.         "/I<SfillParagraph"
  84.         "/I<S<O<IwrapParagraph"
  85.         "/I<S<O<I<BsentenceParagraph"
  86.         "/U<S<OfillRegion"
  87.         "/U<S<I<OwrapRegion"
  88.         "<E<SupcaseRegion"
  89.         "<SdowncaseRegion"
  90.         "(-"
  91.         "<SreverseSort"
  92.         "<SsortLines"
  93.         "/L<I<OspellcheckWindow"
  94.         "zapInvisibles"
  95.         "<SspacesToTabs"
  96.         "<StabsToSpaces"
  97.         "(-"
  98.         "/D<ScommentLine"
  99.         "/D<S<I<OuncommentLine"
  100.         "<SuncommentBox"
  101.         "<ScommentBox"
  102.         "<S<EuncommentParagraph"
  103.         "<ScommentParagraph"
  104.         "(-"
  105.         "textToAlpha"
  106. }
  107.  
  108. proc strip {arg} {
  109.     if {[regsub -all {\\([][\{\}])} $arg {\1} v]} {return $v}
  110.     return $arg
  111. }
  112.  
  113. #===============================================================================
  114. proc helpMenu {item} {
  115.     global HOME
  116.     edit -r "$HOME:Help:$item"
  117. }
  118. set men { "Quick Start" "Readme" "Changes" "(-" }
  119.  
  120. foreach f [lsort -ignore [glob "$HOME:Help:*"]] {
  121.     set f [file tail $f]
  122.     if {[lsearch $men $f] < 0} {
  123.         lappend men $f
  124.     }
  125. }
  126. foreach f $men {
  127.     addHelpMenu $f
  128. }
  129. unset men
  130. #===============================================================================
  131.  
  132.  
  133. proc escapeSpaces {str} {
  134.     regsub -all { } $str {\ } str2
  135.     return $str2
  136. }
  137.  
  138.  
  139. proc buildSwitches {} {
  140.     global switchApps
  141.     
  142.     menu -m -n switchTo -p switchProc {"<O<I/NNow╔" "Add╔" "Remove╔" "(-"}
  143.  
  144.     if {[info exists switchApps] && [llength $switchApps]} {
  145.         foreach app $switchApps {
  146.             lappend names [file tail $app]
  147.         }
  148.         foreach name [lsort -ignore $names] {
  149.             addMenuItem -m -l "blah" switchTo $name
  150.         }
  151.     }
  152. }
  153.  
  154.  
  155. proc switchProc {menu name} {
  156.     global switchTo switchApps
  157.  
  158.     if {$name == "Add"} {
  159.         set fname [getfile "Pick an app:"]
  160.         lappend switchApps $fname
  161.         addDef switchApps $switchApps
  162.         buildSwitches
  163.     } elseif {$name == "Remove"} {
  164.         foreach app $switchApps {
  165.             lappend apps [file tail $app]
  166.         }
  167.         set name [listpick -p "Remove which app?" $apps]
  168.         if {[set ind [lsearch $switchApps "*$name"]] >= 0} {
  169.             set switchApps [lreplace $switchApps $ind $ind]
  170.             addDef switchApps $switchApps
  171.             buildSwitches
  172.         }
  173.     } elseif {$name == "Now"} {
  174.         switchApp
  175.     } else {
  176.         if {[set ind [lsearch $switchApps "*$name"]] >= 0} {
  177.             if {[catch {switchTo $name}]} {
  178.                 launch -f [lindex $switchApps $ind]
  179.             }
  180.         }
  181.     }
  182. }
  183.         
  184.  
  185. proc winTileProc {menu item} {
  186.     win$item
  187. }
  188.  
  189.  
  190. menu -n $winMenu -p menuWin {
  191.         "//<SsinglePage"
  192.         "//<Szoom"
  193.         "<S/;chooseAWindow"
  194.         "/Y<O<Iiconify"
  195.         {menu -n arrange -p winTileProc {
  196.             "/Jvertically^1"
  197.             "/J<O<Ihorizontally^2"
  198.             "tiled^3"
  199.             "overlay^4"
  200.             "(-"
  201.             }}
  202.         "modifyModeFlags╔"
  203.         "(-"
  204.         "/isetFontsTabs╔"
  205.         "/jsplitWindow"
  206.         "/ltoggleScrollbar"
  207.         "(-"
  208. }
  209.  
  210. # We may be reloading, so add whatever windows we have
  211. if {[info exists winNameToNum]} {
  212.     set nms [array names winNameToNum]
  213.     foreach name $nms {
  214.         regexp {[^:]*$} $name item
  215.         set num $winNameToNum($name)
  216.         if {$num < 10}     {
  217.             addMenuItem -m $winMenu /$num$item
  218.         } else {
  219.             addMenuItem -m $winMenu $item
  220.         }
  221.     }
  222. }
  223.  
  224. insertMenu "File"
  225. insertMenu "Edit"
  226. insertMenu "Search"
  227. insertMenu "Text"
  228. catch {enableMenuItem NamedClipboards paste off}
  229. menu -n $fsetMenuName {}; 
  230. insertMenu $winMenu
  231.  
  232. # catch {insertMenu $helpMenu}
  233.  
  234.  
  235. menu -n $toolserverMenu {}
  236.  
  237.  
  238. #===============================================================================
  239. # Stuff that needs to be here for AlphaLite.
  240. #===============================================================================
  241. proc rebuildTclIndices {} {
  242.     global auto_path
  243.     set d [pwd]
  244.     # do we really need the next line? Alpha's original uses it.
  245.     cd
  246.     foreach dir $auto_path {
  247.         # if directory exists
  248.         if { ![catch { cd $dir } ] } {
  249.             # if there are any files
  250.             if { ![catch { glob *.*tcl } ] } {
  251.                 message "Building [file tail $dir] index╔"
  252.                 
  253.                 # if the '[incr tcl]' version exists, use that
  254.                 # use 'catch' also in case directory is write-protected
  255.                 if [catch { itcl_mkindex : *.*tcl } ] {
  256.                     # else try the normal one
  257.                     catch { auto_mkindex : *.*tcl }
  258.                 }
  259.             }
  260.         }
  261.     }
  262.     # redo the auto-mode-file connections (see "smarterSource.tcl")
  263.     message "Building the mode-file dependency array"
  264.     catch {autoModeFiles}
  265.     message ""
  266.     cd $d
  267. }
  268. proc traceTclProc {} {
  269.     global tclMenu
  270.     if {[llength [traceFunc status]]>2} {
  271.         catch {markMenuItem $tclMenu {traceTclProc╔} off}
  272.         catch {enableMenuItem $tclMenu dumpTraces off}
  273.         if {[string length [set data [traceDump]]]} {
  274.             if {[askyesno "Dump traces?"] == "yes"} {
  275.                 dumpTraces [string trimright [lindex [traceFunc status] 3] {,}] $data
  276.                 setWinInfo dirty 0
  277.             }
  278.         }
  279.         traceFunc off
  280.         message "Tracing off."
  281.         return
  282.     }
  283.     if {[llength [winNames]] && [string length [set sel [getSelect]]]} {
  284.         set func [listpick -L $sel -p {Func Name:} [lsort -ignore [info procs]]]
  285.     } else {
  286.         set func [listpick -p {Func Name:} [lsort -ignore [info procs]]]
  287.     }
  288.     if {![string length $func]} return
  289.     traceFunc on $func ""
  290.     catch {markMenuItem $tclMenu {traceTclProc╔} on}
  291.     catch {enableMenuItem $tclMenu dumpTraces on}
  292.     message "Tracing '$func'╔"
  293. }
  294.  
  295.  
  296. proc dumpTraces {{name ""} {data ""}} {
  297.     if {![string length $name]} {
  298.         set name [string trimright [lindex [traceFunc status] 3] {,}]
  299.     }
  300.     if {![string length $data]} {
  301.         set data [traceDump]
  302.     }
  303.     
  304.     if {![string length $data]} {
  305.         message "Trace buffer empty"
  306.     } else {
  307.         new -n "* Trace '$name' *"
  308.         insertText $data
  309.         setWinInfo dirty 0
  310.         goto 0 
  311.     }
  312. }
  313. proc carriageReturn {} {
  314.     global mode
  315.     global indentOnCR
  316.     set indentString ""
  317.     deleteText [getPos] [selEnd]
  318.     if {$indentOnCR} {
  319.         set pos [getPos]
  320.         set text [getText [lineStart $pos] $pos]
  321.         for {set i 0; set len [string length $text]} {$i <= $len} {incr i} {
  322.             set c [string index $text $i]
  323.             if {($c != "\t") && ($c != "\ ")} {
  324.                 set indentString [string range $text 0 [expr $i-1]]
  325.                 break
  326.             }
  327.         }
  328.     }
  329.     insertText "\r" $indentString
  330. }
  331.